perm filename SEG.SAI[4,ALS] blob sn#054418 filedate 1973-07-19 generic text, type T, neo UTF8
00010	BEGIN "SEGMENT"
00020	DEFINE ⊂="COMMENT";	⊂ 7/19/73;
00030	⊂ This program has been simplified for use in getting segmentation
00040	results for the workshop. All on line output has been removed. The
00050	progra handle utterances of almost any length altho there is only
00060	space for 100 segments of each of three classes;
00070	
00080	REQUIRE "BLOCKS.HDR" SOURCE_FILE;
00090	REQUIRE "SIG" LOAD_MODULE;
00100	
00110	
00120	EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00130	EXTERNAL STRING PROCEDURE INCHWL;
00140	DEFINE BUFSIZ="1024",CNTSIZ="100";
00150	STRING TFILEI,FILEI,OPT1,MESS;
00160	INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00170	INTEGER ARRAY LFILE[0:'177];
00180	INTEGER CHAN1,CHAN4,CHAN6,EOF,IEOF,FILEC,COUT,LOUT;
00190	INTEGER BPT,SEGCNT,SEGTOT,H,I,J,K,L,Q;
00200	INTERNAL INTEGER M,N,P,RATE,FLAG,SEGC,INTOT,HINT,TFLAG,UPCNT,TABTOT;
00210	INTERNAL INTEGER CFLAG,PHW;
00220	LABEL STRT,LABELA,LABELB,ZZZZ,FINISH;
00230	INTEGER ARRAY LEV1,LEV2,LEV3,LEV4,SEG1,SEG2,SEG3,SEG4,LEVH,SEGH[0:CNTSIZ];
00240	INTEGER ARRAY FEAT[0:7];
00250	INTEGER SFOUND,SGIVEN,SHRIGHT,SHWRONG,SHMISS,SPRIGHT,SPWRONG,SPMIX;
00260	INTEGER SPMISS,FOUND,GIVEN,HRIGHT,HWRONG,HMISS,PRIGHT,PWRONG,PMIX,PMISS;
00270	INTEGER HPOINT,HSTRT,HEND,FSTRT,FEND,RMIX,WMIX,SRMIX,SWMIX;
00280	STRING LAB;
00290	INTEGER CON1,CON2,CON3,CON4;
00300	DEFINE TABSIZ="256",TABNUM="16",ARRSIZ="4096";
00310	INTERNAL INTEGER ARRAY USE[0:ARRSIZ];
00320	INTERNAL INTEGER ARRAY RES,LRN[0:1];	⊂ Required for linkage reasons only;
00330	
00340	DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
00350	DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
00360	DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
00370	
00380	INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00390	BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00400	  BOOLEAN NF;
00410	  LOOKUP(CHAN,FILENAME,NF);
00420	  WHILE NF DO
00430	  BEGIN
00440	    OUTSTR(CR&LF&"Can't find "&FILENAME&". try [1,VIN],  File=");
00450	    FILENAME ← INCHWL ;
00460	    LOOKUP(CHAN,FILENAME,NF)
00470	  END;
00480	END "LOOKIN";
00490	
00500	PROCEDURE CLASS;
00510	BEGIN "CLASS"
00520	 IF EQU(LAB,"VOICED")∨EQU(LAB,"FRIC  ")∨EQU(LAB,"VOIFRI")
00530		∨EQU(LAB,"VS    ")∨EQU(LAB,"STOP  ")  THEN
00540	
00550	 BEGIN  LEV1[CON1]←LOUT;  SEG1[CON1]←COUT;
00560	  IF CON1<CNTSIZ THEN CON1←CON1+1 ELSE OUTSTR("Level 1 overflow"); END
00570	
00580	 ELSE IF
00590	EQU(LAB,"SCHWA ")∨EQU(LAB,"NASAL ")∨EQU(LAB,"GLIDE ")∨EQU(LAB,"VOWEL ")
00600	  THEN
00610	 BEGIN LEV2[CON2]←LOUT; SEG2[CON2]←COUT;
00620	  IF CON2<CNTSIZ THEN CON2←CON2+1 ELSE OUTSTR("Level 2 overflow"); END
00630	
00640	 ELSE IF EQU(LAB,"S/T   ")∨EQU(LAB,"SH/K  ")∨EQU(LAB,"F/P   ") THEN
00650	 BEGIN  LEV3[CON3]←LOUT; SEG3[CON3]←COUT;
00660	  IF CON3<CNTSIZ THEN CON3←CON3+1 ELSE OUTSTR("Level 3 overflow"); END
00670	
00680	 ELSE  BEGIN  LEV4[CON4]←LOUT; SEG4[CON4]←COUT;
00690	  IF CON4<CNTSIZ THEN CON4←CON4+1 ELSE OUTSTR("Level 4 overflow"); END;
00700	END "CLASS";
00710	
00720	PROCEDURE REPORT;
00730	BEGIN "REP"
00740	  INTEGER I,J,K,L;
00750	   IF CFLAG≠0 THEN BEGIN
00760		CFLAG←0;
00770	 FOR I←0 STEP 1 UNTIL TABNUM-1 DO  BEGIN
00780	 IF NAMES[I]=0 THEN DONE ELSE
00790	 IF STOP[I]≠0 THEN BEGIN "CT"
00800	  IF LDB(POINT(9,STOP[I],8))≠0 THEN BEGIN
00810	  LOUT←OUT1[I];  LAB←CVXSTR(LOUT); K←LDB(POINT(9,START[I],8));
00820	  IF SEGC-K≥512 THEN K←K+512;
00830	   COUT←(K LSH 24)+((SEGC-2) LSH 12)+LDB(POINT(9,CMAX[I],8));
00840	  CLASS; DPB(0,POINT(9,STOP[I],8)); DPB(0,POINT(9,CMAX[I],8)); END;
00850	
00860	  IF LDB(POINT(9,STOP[I],17))≠0 THEN BEGIN
00870	  LOUT←OUT2[I];  LAB←CVXSTR(LOUT); K←LDB(POINT(9,START[I],17));
00880	  IF SEGC-K≥512 THEN K←K+512;
00890	   COUT←(K LSH 24)+((SEGC-2) LSH 12)+LDB(POINT(9,CMAX[I],17));
00900	  CLASS; DPB(0,POINT(9,STOP[I],17)); DPB(0,POINT(9,CMAX[I],17)); END;
00910	
00920	  IF LDB(POINT(9,STOP[I],26))≠0 THEN BEGIN
00930	  LOUT←OUT3[I];  LAB←CVXSTR(LOUT); K←LDB(POINT(9,START[I],26));
00940	  IF SEGC-K≥512 THEN K←K+512;
00950	   COUT←(K LSH 24)+((SEGC-2) LSH 12)+LDB(POINT(9,CMAX[I],26));
00960	  CLASS; DPB(0,POINT(9,STOP[I],26)); DPB(0,POINT(9,CMAX[I],26)); END;
00970	
00980	  IF LDB(POINT(9,STOP[I],35))≠0 THEN BEGIN
00990	  LOUT←OUT4[I];  LAB←CVXSTR(LOUT); K←LDB(POINT(9,START[I],35));
01000	  IF SEGC-K≥512 THEN K←K+512;
01010	   COUT←(K LSH 24)+((SEGC-2) LSH 12)+LDB(POINT(9,CMAX[I],35));
01020	  CLASS; DPB(0,POINT(9,STOP[I],35)); DPB(0,POINT(9,CMAX[I],35)); END;
01030	
01040	 END "CT"; END; END;
01050	END "REP";
01060	
01070	PROCEDURE ORDER;
01080	BEGIN "ORDER"
01090	INTEGER I,J,K,L;
01100	FOR I←0 STEP 1 UNTIL CON1-2 DO
01110	  FOR J←I+1 STEP 1 UNTIL CON1-1 DO
01120	    IF LDB(POINT(12,SEG1[J],11))<LDB(POINT(12,SEG1[I],11)) THEN
01130	      BEGIN K←LEV1[J]; LEV1[J]←LEV1[I]; LEV1[I]←K;
01140	            K←SEG1[J]; SEG1[J]←SEG1[I];SEG1[I]←K; END;
01150	FOR I←0 STEP 1 UNTIL CON2-2 DO
01160	  FOR J←I+1 STEP 1 UNTIL CON2-1 DO
01170	    IF LDB(POINT(12,SEG2[J],11))<LDB(POINT(12,SEG2[I],11)) THEN
01180	      BEGIN K←LEV2[J]; LEV2[J]←LEV2[I]; LEV2[I]←K;
01190	            K←SEG2[J]; SEG2[J]←SEG2[I]; SEG2[I]←K; END;
01200	FOR I←0 STEP 1 UNTIL CON3-2 DO
01210	  FOR J←I+1 STEP 1 UNTIL CON3-1 DO
01220	    IF LDB(POINT(12,SEG3[J],11))<LDB(POINT(12,SEG3[I],11)) THEN
01230	      BEGIN K←LEV3[J]; LEV3[J]←LEV3[I]; LEV3[I]←K;
01240	            K←SEG3[J]; SEG3[J]←SEG3[I]; SEG3[I]←K; END;
01250	FOR I←0 STEP 1 UNTIL CON4-2 DO
01260	  FOR J←I+1 STEP 1 UNTIL CON4-1 DO
01270	    IF LDB(POINT(12,SEG4[J],11))<LDB(POINT(12,SEG4[I],11)) THEN
01280	      BEGIN K←LEV4[J]; LEV4[J]←LEV4[I]; LEV4[I]←K;
01290	            K←SEG4[J]; SEG4[J]←SEG4[I]; SEG4[I]←K; END;
01300	END "ORDER";
01310	
01320	PROCEDURE CHART;
01330	BEGIN "CHART"
01340	INTEGER ARRAY LEVA,SEGA[0:800];
01350	INTEGER X,Y,Z,XX,YY,ZZ,LEVS,IMAX,P,Q,HSTRT,HLONG,HEND,HFLAG;
01360	STRING STR1,HINT;
01370	
01380	
01390	I←0;			⊂ Rearrange order for printing;
01400	FOR J←0 STEP 1 UNTIL 100 DO
01410	 IF LEV1[J]≠0 THEN BEGIN
01420	  LEVA[I]←LEV1[J]; SEGA[I]←SEG1[J]; LEV1[J]←0;
01430	  FOR K←J+1 STEP 1 UNTIL 100 DO
01440	   IF LEV1[K]=LEVA[I] THEN BEGIN
01450	    I←I+1; LEVA[I]←LEV1[K]; SEGA[I]←SEG1[K]; LEV1[K]←0; END;
01460	  I←I+1; END;
01470	LEVA[I]←CVSIX("ZZZZ"); I←I+1; ⊂ To produce a space;
01480	
01490	FOR J←0 STEP 1 UNTIL 100 DO
01500	 IF LEV2[J]≠0 THEN BEGIN
01510	  LEVA[I]←LEV2[J]; SEGA[I]←SEG2[J]; LEV2[J]←0;
01520	  FOR K←J+1 STEP 1 UNTIL 100 DO
01530	   IF LEV2[K]=LEVA[I] THEN BEGIN
01540	    I←I+1; LEVA[I]←LEV2[K]; SEGA[I]←SEG2[K]; LEV2[K]←0; END;
01550	  I←I+1; END;
01560	
01570	FOR J←0 STEP 1 UNTIL 100 DO
01580	 IF LEV3[J]≠0 THEN BEGIN
01590	  LEVA[I]←LEV3[J]; SEGA[I]←SEG3[J]; LEV3[J]←0;
01600	  FOR K←J+1 STEP 1 UNTIL 100 DO
01610	   IF LEV3[K]=LEVA[I] THEN BEGIN
01620	    I←I+1; LEVA[I]←LEV3[K]; SEGA[I]←SEG3[K]; LEV3[K]←0; END;
01630	  I←I+1; END;
01640	
01650	FOR J←0 STEP 1 UNTIL 100 DO
01660	 IF LEV4[J]≠0 THEN BEGIN
01670	  LEVA[I]←LEV4[J]; SEGA[I]←SEG4[J]; LEV4[J]←0;
01680	  FOR K←J+1 STEP 1 UNTIL 100 DO
01690	   IF LEV4[K]=LEVA[I] THEN BEGIN
01700	    I←I+1; LEVA[I]←LEV4[K]; SEGA[I]←SEG4[K]; LEV4[K]←0; END;
01710	  I←I+1; END;
01720	LEVA[I]←CVSIX("YYYY"); I←I+1; IMAX←I;
01730	LEVA[I]←0;	⊂ Set stop;
01740	
01750	I←J←LEVS←0; N←100; 
01760	
01770	WHILE I≤400 DO BEGIN "ISTEP"
01780	IF ((N-100) MOD 30)=0 THEN BEGIN 
01790	OUT(CHAN6,FF&CR&FILEI&TB&TB&TB&TB&TB&TB&TB&DATIME&CRLF);
01800	OUT(CHAN6,TB&TB&TB&TB&" time in 1.024 secs."&CRLF); END;
01810	 SETFORMAT(1,0); OUT(CHAN6,CRLF&"     "&CVS(N)[2 TO 2]&"."&CVS(N)[3 TO 3]);
01820	 Q←(N-100)*8; P←20;
01830	 FOR K←1 STEP 1 UNTIL 10 DO BEGIN N←N+1;
01840	  OUT(CHAN6,"  .  "&CVS(N)[2 TO 2]&"."&CVS(N)[3 TO 3]); END;
01850	 LEVS←J←0;
01860	
01870	 WHILE J=0 DO BEGIN "JSTEP"
01880	  IF LEVA[I]=0 THEN DONE;
01890	  IF LEVA[I]=CVSIX("ZZZZ") THEN BEGIN 
01900	   OUT(CHAN6,CRLF);
01910	   IF LEVA[IMAX-1]≠CVSIX("ZZZZ") THEN IF LEVA[IMAX-1]≠CVSIX("YYYY") THEN
01920	   BEGIN 
01930	   LEVA[IMAX]←CVSIX("ZZZZ"); IMAX←IMAX+1; LEVA[IMAX]←0;END; END ELSE
01940	
01950	  IF LEVA[I]=CVSIX("YYYY") THEN BEGIN 
01960	   IF LEVA[IMAX-1]≠CVSIX("YYYY") THEN IF LEVA[IMAX-1]≠CVSIX("ZZZZ") THEN
01970	   BEGIN J←1; OUT(CHAN6,CRLF);
01980	    LEVA[IMAX]←CVSIX("YYYY"); IMAX←IMAX+1; LEVA[IMAX]←0; END; END
01990	
02000	  ELSE BEGIN "SAME-J"
02010	
02020	   IF LEVA[I]≠LEVS THEN BEGIN LEVS←LEVA[I];
02030	    STR1←(CVXSTR(LEVS)&"     ")[1 TO 6];
02040	    Z←0; END;
02050	
02060	   XX←LDB(POINT(12,SEGA[I],11));
02070	    YY←LDB(POINT(12,SEGA[I],23));
02080	IF YY-XX>2 THEN BEGIN
02090	
02100	   IF XX≥160 THEN BEGIN
02110	    SEGA[IMAX]←(SEGA[I] LAND '7777)+((XX-160) LSH 24)+((YY-160) LSH 12);
02120	    LEVA[IMAX]←LEVA[I]; IMAX←IMAX+1; LEVA[IMAX]←0; END
02130	   ELSE BEGIN
02140	
02150	   IF Z=0 THEN OUT(CHAN6,CRLF&STR1);
02160	   X←XX%2; K←X-Z;
02170	   FOR L←1 STEP 1 UNTIL K DO OUT(CHAN6," ");
02180	    Z←YY%2; Y←Z-X;
02190	   IF Z>80 THEN BEGIN
02200	     LEVA[IMAX]←LEVA[I];
02210	     SEGA[IMAX]←(SEGA[I] LAND '7777)+((YY-160) LSH 12);
02220	     Y←81-X;
02230	     IMAX←IMAX+1; LEVA[IMAX]←0; END;
02240	
02250	       K←(((SEGA[I] LAND '777)*10) LSH -9); OUT(CHAN6,CVS(K));
02260	    FOR L←2 STEP 1 UNTIL Y DO
02270	   IF ((X+L-1) MOD 4)=0 THEN OUT(CHAN6,"+")
02280	     ELSE OUT(CHAN6,"-");
02290	    END;
02300	   IF J≠0 THEN DONE; END; IF J≠0 THEN DONE;
02310	   END "SAME-J";
02320	  I←I+1;
02330	  IF LEVA[I]=0 THEN DONE;
02340	  IF J≠0 THEN DONE;
02350	  END "JSTEP";
02360	
02370	IF LEVA[I]=0 THEN OUT(CHAN6,CRLF);
02380	IF LFILE[21]≠0 THEN BEGIN
02390	OUT(CHAN6," Pony "); HEND←-1; P←21;
02400	WHILE Q≤(N-100)*8 DO BEGIN
02410	 WHILE Q>HEND DO BEGIN
02420	 IF LFILE[P]=0 THEN BEGIN HSTRT←999; DONE; END;
02430	  HSTRT←((LDB(POINT(12,LFILE[P],23)))+1)%2;
02440	  HLONG←((LDB(POINT(12,LFILE[P],35)))+1)%2;
02450	  IF HLONG<2 THEN HLONG←2;
02460	  HEND←HSTRT+HLONG-1;
02470	 HINT←CVXSTR(LDB(POINT(12,LFILE[P],11)));
02480	HINT←HINT[5 TO 6];
02490	HFLAG←0;
02500	 P←P+1;
02510	 IF P≥127 THEN BEGIN OUTSTR("No HINTS"&CRLF); DONE END; END;
02520	IF P≥126 THEN DONE;
02530	
02540	  IF Q=HSTRT-1 THEN  BEGIN OUT(CHAN6,HINT); HFLAG←1; Q←Q+2; END ELSE
02550	  IF Q<HSTRT THEN BEGIN OUT(CHAN6," "); Q←Q+1; END ELSE
02560	  IF Q=HSTRT THEN BEGIN OUT(CHAN6,HINT); HFLAG←1; Q←Q+2; END ELSE
02570	   IF HFLAG=0 THEN BEGIN OUT(CHAN6,HINT); Q←Q+2; HFLAG←1; END ELSE
02580	  IF Q>HSTRT THEN BEGIN IF (Q MOD 4)=0 THEN OUT(CHAN6,"+") ELSE
02590	   OUT(CHAN6,"-"); Q←Q+1; END;
02600	
02610	 END; P←P-1; HEND←0;
02620	END;  OUT(CHAN6,CRLF&LF);
02630	 IF LEVA[I]=0 THEN DONE;
02640	 END "ISTEP";
02650	
02660	OUT(CHAN6,"Notes:  The + symbols denote scale divisions only."&CRLF&TB&
02670	 "The numbers on lines are confidence figures (0 to 10)."&CRLF);
02680	IF LFILE[21]≠0 THEN OUT(CHAN6,TB&
02690	"The position of pony data may not be exact because of scale compression."&crlf);
02700	END "CHART";
02710	
02720	PROCEDURE TESTER(INTEGER ARRAY LEV1,SEG1);
02730	BEGIN "TESTER"
02740	INTEGER RFLAG,WFLAG,MFLAG,CONF,RCONF,WCONF;
02750	
02760	OUT(CHAN6,CRLF);
02770	H←0;
02780	FOR I←21 STEP 1 UNTIL 127 DO BEGIN
02790	 IF LFILE[I]=0 THEN DONE;
02800	 K←LDB(POINT(12,LFILE[I],11)) LSH 24;
02810	 FOR J←0 STEP 1 UNTIL 63 DO IF K=PHLIST[J] THEN DONE ELSE
02820	  IF PHLIST[J]=0 THEN  DONE;
02830	 HPOINT←POINT(1,HLIST[J],-1);
02840	 FOR L←0 STEP 1 UNTIL 35 DO IF (ILDB(HPOINT)=1) THEN BEGIN
02850	  FOR K←0 STEP 1 UNTIL 7 DO IF FEAT[K]=FLIST[L] THEN BEGIN
02860	   LEVH[H]←FLIST[L]; SEGH[H]←LFILE[I];H←H+1; DONE END
02870	  ELSE IF FEAT[K]=0 THEN DONE;
02880	 END;
02890	END;
02900	
02910	FOR I←0 STEP 1 UNTIL 7 DO BEGIN "TAB"
02920	 IF FEAT[I]=0 THEN DONE;
02930	 GIVEN←HRIGHT←HWRONG←HMISS←RMIX←WMIX←J←0;
02940	
02950	 WHILE LEVH[J]≠0 DO BEGIN
02960	  WHILE LEVH[J]≠FEAT[I] DO BEGIN IF LEVH[J]=0 THEN DONE; J←J+1; END;
02970	  IF LEVH[J]=0 THEN DONE;
02980	  GIVEN←GIVEN+1; RFLAG←WFLAG←MFLAG←RCONF←WCONF←0;
02990	  HSTRT←LDB(POINT(12,SEGH[J],23));
03000	  HEND←LDB(POINT(12,SEGH[J],35))+HSTRT-1;
03010	  FOR K←0 STEP 1 UNTIL CNTSIZ DO BEGIN
03020	   IF (FSTRT←LDB(POINT(12,SEG1[K],11))+1)>HEND THEN
03030	    BEGIN IF (RFLAG+WFLAG)=0 THEN HMISS←HMISS+1;
03040	     IF MFLAG≠0 THEN BEGIN HWRONG←HWRONG-1; HRIGHT←HRIGHT-1;
03050	      IF RCONF≥WCONF THEN RMIX←RMIX+1 ELSE WMIX←WMIX+1; END;
03060	     DONE END;
03070	   IF (LDB(POINT(12,SEG1[K],23))-3)>HSTRT THEN BEGIN
03080	    CONF←LDB(POINT(12,SEG1[K],35));
03090	    IF LEV1[K]=FEAT[I] THEN BEGIN IF RFLAG=0 THEN HRIGHT←HRIGHT+1; RFLAG←1;
03100	     IF CONF>RCONF THEN RCONF←CONF; IF WFLAG=1 THEN MFLAG←1;
03110	     END ELSE BEGIN IF WFLAG=0 THEN  HWRONG←HWRONG+1; WFLAG←1;
03120	     IF CONF>WCONF THEN WCONF←CONF; IF RFLAG=1 THEN MFLAG←1; END;
03130	    END;
03140	  END;
03150	  J←J+1;
03160	 END;
03170	
03180	 FOUND←PRIGHT←PWRONG←PMIX←PMISS←K←0;
03190	WHILE LEV1[K]≠0 DO BEGIN
03200	 WHILE LEV1[K]≠FEAT[I] DO BEGIN IF LEV1[K]=0 THEN DONE; K←K+1; END;
03210	 IF LEV1[K]=0 THEN DONE;
03220	 FOUND←FOUND+1; RFLAG←WFLAG←MFLAG←0;
03230	  FSTRT←LDB(POINT(12,SEG1[K],11));
03240	  FEND←LDB(POINT(12,SEG1[K],23));
03250	  FOR J←0 STEP 1 UNTIL CNTSIZ DO BEGIN
03260	   IF (HSTRT←LDB(POINT(12,SEGH[J],23)))>FEND THEN
03270	    BEGIN IF (RFLAG+WFLAG)=0 THEN PMISS←PMISS+1;
03280	     IF MFLAG≠0 THEN BEGIN PWRONG←PWRONG-1; PRIGHT←PRIGHT-1; END; DONE END;
03290	   IF (LDB(POINT(12,SEGH[J],35))+HSTRT-1)>FSTRT THEN
03300	    IF LEVH[J]=FEAT[I] THEN BEGIN IF RFLAG=0 THEN PRIGHT←PRIGHT+1; RFLAG←1;
03310	     IF WFLAG=1 THEN BEGIN IF MFLAG=0 THEN PMIX←PMIX+1; MFLAG←1; END;
03320	     END ELSE BEGIN IF WFLAG=0 THEN  PWRONG←PWRONG+1; WFLAG←1;
03330	     IF RFLAG=1 THEN BEGIN IF MFLAG=0 THEN PMIX←PMIX+1; MFLAG←1; END; END;
03340	  END;
03350	  K←K+1;
03360	 END;
03370	
03380	IF FEAT[I]=0 THEN DONE;
03390	IF (FOUND+GIVEN)≠0 THEN BEGIN OUT(CHAN6,
03400	CVS(GIVEN)&" "&CVS(HRIGHT)&" "&CVS(RMIX)&" "&CVS(WMIX)&" "&CVS(HWRONG)
03410	  &" "&CVS(HMISS)&TB&CVXSTR(FEAT[I])&TB&
03420	CVS(FOUND)&" "&CVS(PRIGHT)&" "&CVS(PMIX)&" "&CVS(PWRONG)&" "&CVS(PMISS)&CRLF);
03430	SFOUND←SFOUND+FOUND; SGIVEN←SGIVEN+GIVEN;
03440	SHRIGHT←SHRIGHT+HRIGHT; SHWRONG←SHWRONG+HWRONG; SHMISS←SHMISS+HMISS;
03450	SPRIGHT←SPRIGHT+PRIGHT; SPWRONG←SPWRONG+PWRONG; SPMIX←SPMIX+PMIX; SPMISS←SPMISS+PMISS;
03460	SWMIX←SWMIX+WMIX; SRMIX←SRMIX+RMIX;
03470	END;
03480	END "TAB";
03490	
03500	END "TESTER";
03510	
03520	PROCEDURE TEST;
03530	BEGIN "TEST"
03540	
03550	OUT(CHAN6,FF&TB&TB&TB&"  A.I. Laboratory"&
03560	  TB&CRLF&TB&TB&TB&"Stanford University"
03570	 &CRLF&LF&TB&"Segmentation data for ARPA Speech Segmentation Report"&CRLF);
03580	IF LFILE[21]≠0 THEN
03590	OUT(CHAN6,TB&"  Pony data after SCRL as spotted by R.Thosar or N.Miller"&crlf);
03600	OUT(CHAN6,CRLF&"Data file "&FILEI&"  "&TB&tb&TB&DATIME&CRLF);
03610	FOR I←10 STEP 1 UNTIL 20 DO OUT(CHAN6,CVXSTR(LFILE[I]));
03620	OUT(CHAN6,CRLF);
03630	IF MESS≠"" THEN OUT(CHAN6,"Trained on: "&MESS&CRLF);
03640	OUT(CHAN6,CRLF&TB&TB&TB&"Performance Analysis by Segments"&CRLF&LF);
03650	OUT(CHAN6,TB&"Teacher knows best"&TB&TB&TB&TB&"Program knows best"&CRLF);
03660	OUT(CHAN6," Given Right R-Mix W-Mix Wrong  Miss"&TB&"Feature"&TB
03670	         &" Found Right Mixed Wrong Extra"&CRLF);
03680	
03690	SGIVEN←SFOUND←SHRIGHT←SHWRONG←SRMIX←SWMIX←SHMISS←0;
03700	SPRIGHT←SPWRONG←SPMIX←SPMISS←0;
03710	SETFORMAT(5,0);
03720	FEAT[0]←CVSIX("STOP"); FEAT[1]←CVSIX("VOICED");
03730	FEAT[2]←CVSIX("FRIC"); FEAT[3]←CVSIX("VOIFRI");
03740	FEAT[4]←CVSIX("VS"); FEAT[5]←0;
03750	TESTER(LEV1,SEG1);
03760	
03770	FEAT[0]←CVSIX("SCHWA"); FEAT[1]←CVSIX("NASAL"); FEAT[2]←CVSIX("GLIDE");
03780	FEAT[3]←CVSIX("VOWEL"); FEAT[4]←0;
03790	TESTER(LEV2,SEG2);
03800	
03810	FEAT[0]←CVSIX("S/T"); FEAT[1]←CVSIX("SH/K"); FEAT[2]←CVSIX("F/P");
03820	FEAT[3]←0;
03830	TESTER(LEV3,SEG3);
03840	
03850	FEAT[0]←CVSIX("FRONT"); FEAT[1]←CVSIX("MID"); FEAT[2]←CVSIX("BACK");
03860	FEAT[3]←0;
03870	TESTER(LEV4,SEG4);
03880	OUT(CHAN6,CRLF);
03890	OUT(CHAN6,CVS(SGIVEN)&" "&CVS(SHRIGHT)&" "&CVS(SRMIX)&" "&CVS(SWMIX)
03900	  &" "&CVS(SHWRONG)&" "&CVS(SHMISS)&TB&"Totals"&TB&CVS(SFOUND)
03910	  &" "&CVS(SPRIGHT)&" "&CVS(SPMIX)&" "&CVS(SPWRONG)&" "&CVS(SPMISS)&CRLF);
03920	
03930	END "TEST";
03940	
03950	PROCEDURE NJM;
03960	BEGIN
03970	INTEGER CHAN5;
03980	STRING NAME;
03990	INTEGER ARRAY NJMD[0:400];
04000	
04010	CHAN5←5;
04020	CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,0,10,0,0,EOF); 
04030	SETFORMAT(1,0); NAME←"SEG"&CVS(FILEC)&".NJM";
04040	ENTER(CHAN5,NAME,0);
04050	
04060	FOR I←0 STEP 1 UNTIL CON1-1 DO BEGIN
04070	N←I*4; NJMD[N]←LEV1[I]; NJMD[N+1]←(LDB(POINT(12,SEG1[I],35))*100) LSH -9;
04080	NJMD[N+2]←LDB(POINT(12,SEG1[I],11)); NJMD[N+3]←LDB(POINT(12,SEG1[I],23));
04090	END; ARRYOUT(CHAN5,NJMD[0],N);
04100	
04110	FOR I←0 STEP 1 UNTIL CON2-1 DO BEGIN
04120	N←I*4; NJMD[N]←LEV2[I]; NJMD[N+1]←(LDB(POINT(12,SEG2[I],35))*100) LSH -9;
04130	NJMD[N+2]←LDB(POINT(12,SEG2[I],11)); NJMD[N+3]←LDB(POINT(12,SEG2[I],23));
04140	END; ARRYOUT(CHAN5,NJMD[0],N);
04150	
04160	FOR I←0 STEP 1 UNTIL CON3-1 DO BEGIN
04170	N←I*4; NJMD[N]←LEV3[I]; NJMD[N+1]←(LDB(POINT(12,SEG3[I],35))*100) LSH -9;
04180	NJMD[N+2]←LDB(POINT(12,SEG3[I],11)); NJMD[N+3]←LDB(POINT(12,SEG3[I],23));
04190	END; ARRYOUT(CHAN5,NJMD[0],N);
04200	
04210	FOR I←0 STEP 1 UNTIL CON4-1 DO BEGIN
04220	N←I*4; NJMD[N]←LEV4[I]; NJMD[N+1]←(LDB(POINT(12,SEG4[I],35))*100) LSH -9;
04230	NJMD[N+2]←LDB(POINT(12,SEG4[I],11)); NJMD[N+3]←LDB(POINT(12,SEG4[I],23));
04240	END; ARRYOUT(CHAN5,NJMD[0],N);
04250	
04260	CLOSE(CHAN5); RELEASE(CHAN5);
04270	
04280	END;
     

00010	FILEI←"SEG1.T0[77,THO]";UPCNT←3;OPT1←"N";FILEC←0; CHAN4←4;CHAN6←6;
00020	HEADIN;
00030	FOR I←0 STEP 1 UNTIL 15 DO IF NAMES[I]=0 THEN DONE; TABTOT←I*TABSIZ;
00040	OUTSTR("TABTOT= "&CVS(TABTOT)&CRLF);
00050	FLAG←0; SIG(P); FLAG←1;  ⊂ To preset addrssses in SIG;
00060	CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00070	LOOKUP(CHAN1,"USE.DAT",0);ARRYIN(CHAN1,USE[0],TABTOT);CLOSE(CHAN1);
00080	RELEASE(CHAN1);
00090	OUTSTR("Trained on: (CR or type)="); MESS←INCHWL;
00100	
00110	IF STRIN("Should previous data be saved as TELL.DOC? (Y or CR) ")≠"Y" THEN
00120	BEGIN    OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF); ENTER(CHAN6,"TELL.DOC",0);
00130	 CLOSE(CHAN6); END ELSE
00140	IF STRIN("Should old TELL.DOC be spooled YorN = ")="Y" THEN
00150	BEGIN    OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF); LOOKUP(CHAN6,"TELL.DOC",0);
00160	  RENAME(CHAN6,"TELL.OLD",0,EOF); CLOSE(CHAN6);
00170	  SPOOL("TELL.OLD",GETCHAN,1); END;
00180	
00190	
00200	⊂ **** MAIN ROUTINE STARTS HERE****;
00210	STRT: CLOSE(CHAN6);
00220	IF OPT1≠"Y" THEN
00230	IF (TFILEI←STRIN("Data file FFT/LPC ("&FILEI&")="))≠"" THEN FILEI←TFILEI
00240	ELSE OPT1←"Y";
00250	IF OPT1="Y" THEN BEGIN FILEC←FILEC+1;  SETFORMAT(1,0);
00260	  FILEI←"SEG"&CVS(FILEC)&".T0[77,THO]";
00270	  OUTSTR("Starting on "&FILEI); END;
00280	
00290	 FOR I←0 STEP 1 UNTIL TABNUM-1 DO START[I]←STOP[I]←CMAX[I]←0;
00300	FOR I←0 STEP 1 UNTIL CNTSIZ DO BEGIN LEV1[I]←LEV2[I]←LEV3[I]←LEV4[I]←0;
00310	SEG1[I]←SEG2[I]←SEG3[I]←SEG4[I]←0; END;
00320	CON1←CON2←CON3←CON4←0; CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00330	LOOKIN(CHAN4,FILEI); EOF←SEGC←SEGCNT←0;
00340	ARRYIN(CHAN4,LFILE[0],'200);	⊂ Input header;
00350	SEGTOT←(LFILE[0])*3%128; RATE←LFILE[2];
00360	OUTSTR(TB&"Segtot="&CVS(SEGTOT)&TB&"Sampling rate="&CVS(LFILE[2])&CRLF);
00370	IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
00380	
00390	OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF); LOOKUP(CHAN6,"TELL.DOC",0);
00400	DEFINE UGETF="'073000000000"; START_CODE; UGETF	6,I; END;
00410	ENTER(CHAN6,"TELL.DOC",0); USETO(CHAN6,I);
00420	OUT(CHAN6,TB&TB&TB&"  A.I. Laboratory"&
00430	  TB&CRLF&TB&TB&TB&"Stanford University"
00440	 &CRLF&LF&TB&"Segmentation data for ARPA Speech Segmentation Report"&CRLF);
00450	IF LFILE[21]≠0 THEN
00460	OUT(CHAN6,TB&"Pony data after SCRL as spotted by R.Thosar or N.Miller"&crlf);
00470	OUT(CHAN6,CRLF&TB&"Data file "&FILEI&"  "&TB&TB&DATIME&CRLF&TB);
00480	FOR I←10 STEP 1 UNTIL 20 DO OUT(CHAN6,CVXSTR(LFILE[I]));
00490	OUT(CHAN6,CRLF);
00500	IF MESS≠"" THEN OUT(CHAN6,TB&"Trained on: "&MESS&CRLF);
00510	SETFORMAT(5,0);
00520	
00530	LABELA: ⊂ Put all outputs into the off state;
00540	FOR I←0 STEP 1 UNTIL TABNUM-1 DO START[I]←STOP[I]←CMAX[I]←0;
00550	CON1←CON2←CON3←CON4←0;  HINT←H←0;
00560	
00570	WHILE EOF=0 DO BEGIN "DATAIN"
00580	  ARRYIN(CHAN4,DATBUF[0],BUFSIZ); ⊂ Get data;
00590	  BPT←POINT(6,DATBUF[0],-1);
00600	  
00610	  FOR Q←1 STEP 1 UNTIL BUFSIZ%4 DO BEGIN  
00620	    SEGC←SEGC+1;
00630	    IF SEGC>SEGTOT THEN DONE;
00640	    FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
00650	LABELB: SIG(P); REPORT;
00660	  END;
00670	IF SEGC>SEGTOT THEN DONE;
00680	END "DATAIN"; CLOSE(CHAN4);
00690	
00700	   FOR I←0 STEP 1 UNTIL INSIZ-1 DO  INDAT[I]←0;
00710	   FOR I←0 STEP 1 UNTIL 4 DO BEGIN SEGC←SEGC+1;  SIG(P); REPORT; END;
00720	
00730	⊂ **** Off line listing of counter outputs ****;
00740	ORDER;
00750	
00760	NJM;
00770	
00780	SETFORMAT(5,0);
00790	OUT(CHAN6,CRLF&TB&
00800	"In CMU units    SEG."&TB&"Conf."&TB&" In units of 6.4 ms.");
00810	OUT(CHAN6,CRLF&TB&"Begin"&TB&"  End  "
00820	         &TB&"Label"&TB&"Level"&TB&"Begin"&TB&"  End"
00830		&TB&"Count"&CRLF);
00840	OUT(CHAN6,CRLF&TB&
00850	 "First level [voiced, fric., voiced-fric., stop]"
00860	&CRLF);
00870	FOR I←0 STEP 1 UNTIL CON1-1 DO BEGIN
00880	 J←LDB(POINT(12,SEG1[I],11)); L←LDB(POINT(12,SEG1[I],23)); K←L-J+1;
00890	OUT(CHAN6,CRLF&TB&CVS((J LSH 6)-63)&TB&CVS((L LSH 6)-63)&TB
00900	 &CVXSTR(LEV1[I])&TB
00910	 &CVS((LDB(POINT(12,SEG1[I],35))*100) LSH -9)
00920	 &TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
00930	OUT(CHAN6,CRLF&LF&TB& "Voiced [vowel, glide, nasal]"&CRLF);
00940	
00950	 FOR I←0 STEP 1 UNTIL CON2-1 DO BEGIN
00960	 J←LDB(POINT(12,SEG2[I],11)); L←LDB(POINT(12,SEG2[I],23)); K←L-J+1;
00970	OUT(CHAN6,CRLF&TB&CVS((J LSH 6)-63)&TB&CVS((L LSH 6)-63)&TB
00980	 &CVXSTR(LEV2[I])&TB
00990	 &CVS((LDB(POINT(12,SEG2[I],35))*100) LSH -9)
01000	 &TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01010	   OUT(CHAN6,CRLF&LF&TB&"Fricatives [S/T, SH/K, F/P]"&CRLF);
01020	
01030	 FOR I←0 STEP 1 UNTIL CON3-1 DO BEGIN
01040	  J←LDB(POINT(12,SEG3[I],11)); L←LDB(POINT(12,SEG3[I],23)); K←L-J+1;
01050	OUT(CHAN6,CRLF&TB&CVS((J LSH 6)-63)&TB&CVS((L LSH 6)-63)
01060	  &TB&CVXSTR(LEV3[I])&TB&
01070	  CVS((LDB(POINT(12,SEG3[I],35))*100) LSH -9)
01080	  &TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01090	   OUT(CHAN6,CRLF&LF&TB&"Vowels [front, mid, back]"&CRLF);
01100	 FOR I←0 STEP 1 UNTIL CON4-1 DO BEGIN
01110	  J←LDB(POINT(12,SEG4[I],11)); L←LDB(POINT(12,SEG4[I],23)); K←L-J+1;
01120	OUT(CHAN6,CRLF&TB&CVS((J LSH 6)-63)&TB&CVS((L LSH 6)-63)
01130	  &TB&CVXSTR(LEV4[I])&TB&
01140	 CVS((LDB(POINT(12,SEG4[I],35))*100) LSH -9)
01150	 &TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01160	 OUT(CHAN6,CRLF);
01170	IF LFILE[21]≠0 THEN TEST;
01180	
01190	 CHART; OUT(CHAN6,FF);  CLOSE(CHAN6);
01200	
01210	GO TO STRT;
01220	FINISH:
01230	END "SEGMENT";